Function GetIPAddress()
    Const strComputer As String = "."   ' Computer name. Dot means local computer
    Dim objWMIService, IPConfigSet, IPConfig, IPAddress, i
    Dim strIPAddress As String

    ' Connect to the WMI service
    Set objWMIService = GetObject("winmgmts:" _
        & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

    ' Get all TCP/IP-enabled network adapters
    Set IPConfigSet = objWMIService.ExecQuery _
        ("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled=TRUE")

    ' Get all IP addresses associated with these adapters
    For Each IPConfig In IPConfigSet
        IPAddress = IPConfig.IPAddress
        If Not IsNull(IPAddress) Then
            strIPAddress = strIPAddress & Join(IPAddress, ", ")
        End If
    Next

    GetIPAddress = strIPAddress
End Function


Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
flag = False
For i = LBound(arr) To UBound(arr)
    If arr(i) = stringToBeFound Then
        flag = True
    End If
Next
IsInArray = flag
End Function




Sub t()
 Dim cn As ADODB.Connection
    Dim str As String
    Set cn = New ADODB.Connection
    
    cn.ConnectionString = "DRIVER={MySQL ODBC 5.1 Driver};" & "SERVER=10.7.21.148;" & "DATABASE=worklog;" & "UID=ry;PWD=ry@ncl;OPTION=3"
    
    cn.Open
    
    If (cn.Execute("select count(*) from submitrecord where ipAddress = '" & GetIPAddress & "' and submitTime = '" & Date & "'").Fields.Item(0) >= 3) Then
        MsgBox "同一ip地址在一天内只能插入三次！日志导入失败"
        Exit Sub
    End If
    
    'Open "C:\tttt.txt" For Output As #1
  
    Set xlsheet = ThisWorkbook.ActiveSheet
    
    
    
  ' Automatically get the variable of start rows
  'MsgBox xlsheet.Cells(1, 1)
  
  startrow = -1
  For jj = 1 To ActiveSheet.UsedRange.Rows.Count
     If xlsheet.Cells(jj, 1).Value = "所属团队" And xlsheet.Cells(jj, 2).Value = "填报人" And xlsheet.Cells(jj, 3).Value = "日期" And xlsheet.Cells(jj, 4).Value = "工作类别" And xlsheet.Cells(jj, 5).Value = "工作明细" And xlsheet.Cells(jj, 6).Value = "所属需求/问题单" And xlsheet.Cells(jj, 7).Value = "计划起期" And xlsheet.Cells(jj, 8).Value = "计划止期" And xlsheet.Cells(jj, 9).Value = "此项工作计划所需工作日" And xlsheet.Cells(jj, 10).Value = "任务进度百分比" And xlsheet.Cells(jj, 11).Value = "今日使用工时" And xlsheet.Cells(jj, 12).Value = "今日加班工时" And xlsheet.Cells(jj, 13).Value = "备注" Then
        startrow = jj + 1
        Exit For
    End If

  Next
  
  If startrow < 0 Then
    MsgBox "工作日志列数不对，必须有以下列: 所属团队    日期    工作类别    工作明细    所属需求/问题单 计划起期    计划止期    此项工作计划所需工作日  任务进度百分比  今日使用工时    今日加班工时    备注"
    MsgBox "日志导入失败"
    Exit Sub
  End If
  

  '前四项必须填写'
  
  For i = startrow To ActiveSheet.UsedRange.Rows.Count
    emptyrow = True
    For j = 1 To ActiveSheet.UsedRange.Columns.Count
      If (xlsheet.Cells(i, j).Value <> "") Then
            emptyrow = False
            Exit For
      End If
    Next
    
    
    If Not emptyrow Then
        For k = 1 To 4
            If (xlsheet.Cells(i, k).Value = "") Then
                MsgBox "第 " & i & " 行前四项必须填写"
                MsgBox "日志导入失败"
                Exit Sub
            End If
        Next
    End If
    
  Next
  
  
  
  
  '校验工作日志日期合法性
  For i = startrow To ActiveSheet.UsedRange.Rows.Count
  
        
        On Error GoTo mywrong
        
        temp = CDate(xlsheet.Cells(i, 3).Value)
        
        temp = CDate(xlsheet.Cells(i, 7).Value)
        
        temp = CDate(xlsheet.Cells(i, 8).Value)
    
  Next
  
' 日期格式错误处理
mywrong:
     If (Err.Number) Then
         MsgBox "日期格式不对，请检查第 " & i & " 行日期格式"
         MsgBox "日志导入失败"
         Exit Sub
     End If
  '检查百分比进度合法性
  
  For i = startrow To ActiveSheet.UsedRange.Rows.Count
    If xlsheet.Cells(i, 10).Value > 1 Then
        MsgBox "第 " & i & " 行进度百分比不能大于1"
        Exit Sub
    End If
  Next
  
  
  '工作类别校验'
  worktype = Array("综合事务", "项目管理", "评审", "发布相关", "设计", "开发编码", "单元测试", "学习培训", "会议", "运维", "配合业务验收", "配合技术测试", "配合联调测试", "临时任务", "其他 ", "请假", "倒休")


  For i = startrow To ActiveSheet.UsedRange.Rows.Count
   emptyrow = True
    For j = 1 To ActiveSheet.UsedRange.Columns.Count
      If (xlsheet.Cells(i, j).Value <> "") Then
            emptyrow = False
            Exit For
      End If
    Next
    
    
    If Not emptyrow Then
        If Not IsInArray(xlsheet.Cells(i, 4).Value, worktype) Then
            MsgBox "第 " & i & " 行工作类别错误,工作类别必须为以下类别中的一个 : " & Join(worktype, " | ") & ""
            Exit Sub
        End If
    End If
  Next
  
  
 ' MsgBox xlsheet.Cells(startrow, 3).Value
   thismonth = xlsheet.Cells(startrow, 3).Value
 
monthstring = Year(DateValue(thismonth)) & "-" & Month(DateValue(thismonth))
  
 a = "delete from worklog_ry where name like '%" & xlsheet.Cells(startrow, 2) & "%' and date_format(time,'%Y-%m') = date_format(str_to_date('" & monthstring & "','%Y-%m'),'%Y-%m')"

 cn.Execute a
 
 
 For i = startrow To ActiveSheet.UsedRange.Rows.Count
    '要求开发人员必须填写工作计划
    If (xlsheet.Cells(i, 4) = "开发编码") And (xlsheet.Cells(i, 7) = "" Or xlsheet.Cells(i, 8) = "" Or xlsheet.Cells(i, 9) = "" Or xlsheet.Cells(i, 10) = "") Then
      MsgBox "第 " & i & " 行 要求开发人员必须填写工作计划 : 计划起期,计划止期,此项工作计划所需工作日,任务进度百分比 四项必须填写"
      MsgBox "日志导入失败"
      Exit Sub
    End If
  Next
  
 'MsgBox a
 'Print #1, a
' cn.Execute a
  
  personId = "0728"
  'loop the sheet to get all worklog_ry into sql clause
  For i = startrow To ActiveSheet.UsedRange.Rows.Count
    
    emptyrow = True
    For j = 1 To ActiveSheet.UsedRange.Columns.Count
      If (xlsheet.Cells(i, j).Value <> "") Then
            emptyrow = False
      End If
    Next
    
    If Not emptyrow Then
        fsql = ""
        
        
        tsql = "insert into worklog_ry(personId,companyName,name,time,workType,workDetail,requirements,startDate,endDate,daysNeed,progressPercentage,hoursToday,overworkHours,note) values "
        
        tsql = tsql & " ('" & personId & "',"
    
        flag = True
        
        ' a for loop to get all the sqls according to excel data
        
        For j = 1 To 13
            If xlsheet.Cells(i, j).Value = "" Then
                If j = 13 Then
                    tsql = tsql & "null"
                Else
                    tsql = tsql & "null,"
                End If
            Else
                If j = 13 Then
                    tsql = tsql & "'" & Replace(Trim(xlsheet.Cells(i, j).Value), "'", "\'") & "'"
                Else
                    tsql = tsql & "'" & Replace(Trim(xlsheet.Cells(i, j).Value), "'", "\'") & "',"
                End If
            End If
        
        Next
        
        tsql = tsql & ")"
       ' MsgBox tsql
        'Print #1, tsql
         
         On Error GoTo sqlError
         
         'MsgBox tsql
         
        cn.Execute tsql
     End If
  Next

'Sql语句错误处理
sqlError:
    
    If (Err.Number) Then
             MsgBox "导入 Sql 语句错误，当前Sql语句为: 具体错误信息是:" & Err.Description
             MsgBox "日志导入失败"
             'Close #1
             Exit Sub
    End If
cn.Execute "insert into submitrecord (submitTime,ipAddress) values('" & Date & "','" & GetIPAddress & "')"

 
 MsgBox "日志导入完成当前页"
 
 'Close #1
 End Sub

